home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 0467 / winfondf.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-04-02  |  4.0 KB  |  175 lines
  1. program winfond;
  2. {$R WINFOND.RES}
  3. {$I-}
  4. {$M 8192,8192}
  5. uses strings,win31,winprocs,wintypes,Windos;
  6. CONST NBIM = 200;
  7. var Tablo : array[1..NBIM] of string[120];
  8.      valeur,max,compt : integer;
  9.      erreur,fichier,nom,actu,comp1,comp2 : string;
  10.     fin : boolean;
  11.     f : text;
  12.     asciiz,asciiz2,asciiz3 : array[0..80] of char;
  13.     ou,au,texte : Pchar;
  14.     chaine : string[80];
  15.     size : word;
  16.  
  17. label stop;
  18.  
  19. Function majuscule(phrase : string) : string;
  20.  var texte : array[0..255] of char;
  21.      pointe : Pchar;
  22. begin
  23. pointe:=@texte;
  24. StrPCopy(pointe,phrase);
  25. majuscule:=Strpas(AnsiUpper(pointe));
  26. end;
  27.  
  28. Procedure AllInRep(chaine : string; var i : integer);
  29. var result : TSearchRec;
  30.     recherche,pointe : Pchar;
  31.     test : array[1..120] of Char;
  32.     chemin : string;
  33. Begin
  34. recherche:=@test;
  35. chemin:=copy(chaine,1,length(chaine)-5);
  36. StrPcopy(recherche,chaine);
  37. FindFirst(recherche,faAnyFile,result); {recherche du premier .BMP}
  38. If DosError=0 then
  39.    begin
  40.    pointe:=@result.name;
  41.    Tablo[i]:=chemin+StrPas(pointe);
  42.    end;
  43. while DosError = 0 do     {arrΩt en cas d'erreur ou en cas de 18 -> Plus de fichiers}
  44.    begin
  45.    FindNext(result);      {recherche du .BMP suivant}
  46.    if DosError = 0 then
  47.       begin
  48.       i:=i+1;
  49.       pointe:=@result.name;
  50.       Tablo[i]:=chemin+StrPas(pointe);   {Tablo[i] se remplit avec les noms trouvΘs}
  51.       end;
  52.    end;
  53. If (DosError<>0) and (DosError<>18) Then
  54.    erreur:='Erreur dans l''utilisation de *.BMP';
  55.  
  56. end;
  57.  
  58. Procedure Lire(fichier : string);
  59. var f: text;
  60.      i : integer;
  61.     chaine : string;
  62.     test : string;
  63. begin
  64. i:=0;
  65. Assign(f,fichier);
  66. Reset(f);
  67. chaine:='';
  68. Repeat
  69. i:=i+1;
  70. Readln(f,chaine);
  71. test:=copy(chaine,length(chaine)-4,5);
  72. if (majuscule(test)='*.BMP')
  73.    then AllInRep(chaine,i)  {AllInRep permet de trouver tous les .BMP d'un rep.}
  74.    else Tablo[i]:=chaine;
  75. until Eof(f);
  76. Close(f);
  77. end;
  78.  
  79. {
  80. La fonction IsAFile vΘrifie qu'il
  81. s'agit d'un fichier en l'ouvrant
  82. et en vΘrifiant que tout va bien
  83. (ioresult=0)
  84. }
  85. Function IsAFile(chaine : string) : boolean;
  86. var fich : file;
  87. begin
  88. IsAFile:=FALSE;
  89. assign(fich,chaine);
  90. if ioresult<>0
  91. then IsAFile:=FALSE
  92. else
  93.     begin
  94.     reset(fich,1);
  95.     if ioresult<>0
  96.     then
  97.         IsAFile:=FALSE
  98.     else
  99.         begin
  100.         IsAFile:=TRUE;
  101.         close(fich);
  102.         end;
  103.     end;
  104. end;
  105.  
  106. Function IsBMP(chaine : string) : boolean;
  107. const BMP=19778;
  108. var fich : file;
  109.      tipe : word;
  110.      taille : longint;
  111. begin
  112. IsBMP:=FALSE;
  113. assign(fich,chaine);
  114. if ioresult<>0
  115. then IsBMP:=FALSE
  116. else
  117.     begin
  118.     reset(fich,1);
  119.     if ioresult<>0
  120.     then
  121.         IsBMP:=FALSE
  122.     else
  123.         begin
  124.         Blockread(fich,tipe,2);
  125.         if (tipe=BMP)
  126.       and (pos(' ',chaine)=0)
  127.             then Isbmp:=TRUE
  128.             else IsBMP:=FALSE;
  129.         close(fich);
  130.         end;
  131.     end;
  132. end;
  133.  
  134. BEGIN
  135. randomize;
  136. for compt:=1 to NBIM do
  137. Tablo[compt]:='';
  138. fichier:='';
  139. valeur:=-1;
  140. erreur:='RIEN';
  141. if paramcount=1
  142.    then fichier:=paramstr(1)
  143.    else begin erreur:='Nombre de paramΦtres incorrect'; goto stop; end;
  144. if IsAFile(fichier)
  145.    then Lire(fichier)
  146.    else begin erreur:='"'+fichier+'"  n''est pas un fichier texte'; goto stop; end;
  147. for compt:=1 to NBIM do
  148. if Tablo[compt]<>'' then max:=compt;
  149. for compt:=1 to max do
  150.  
  151. fin:=FALSE;
  152.  
  153. {recupere le nom precedent et le stocke dans actu}
  154. comp1:='Franτois CREVOLA'; comp2:='';
  155. ou:=@asciiz;               au:=@asciiz2;
  156. StrPCopy(ou,comp1);        StrPCopy(au,comp2);
  157. {                              returned---\       }
  158. GetProfileString('Desktop','Wallpaper',ou,au,80);
  159. actu:=strpas(au);
  160.  
  161. repeat
  162. Nom:=tablo[random(max)+1];
  163. until (nom<>actu);
  164. if (IsBMP(nom)=FALSE) then begin erreur:='"'+nom+'" n''est pas une image BMP'; goto stop; end else erreur:='RIEN';
  165. ou:=@asciiz;
  166. au:=@asciiz2;
  167. StrPCopy(ou,nom);
  168. StrPCopy(au,actu);                        
  169. WriteProfileString('Desktop', 'WallPaper', ou);
  170. SystemParametersInfo(SPI_SETDESKWALLPAPER,0,au,0);
  171. stop:
  172. texte:=@asciiz3;
  173. StrPcopy(texte,erreur+chr(13)+'( Aide -> WINFOND.HLP )');
  174. if (erreur<>'RIEN') then valeur:=Messagebox(0,texte,'Winfond v1.3 - (c) Franτois CREVOLA 1996',mb_IconStop OR mb_OK);
  175. END.